home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / kcl.lha / c / savemem.c < prev    next >
C/C++ Source or Header  |  1987-06-04  |  7KB  |  333 lines
  1. /*
  2. (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. */
  4.  
  5. /*
  6.     savemem.c
  7.     DG-SPECIFIC
  8. */
  9.  
  10. #include <stdio.h>
  11. #include <packets:create.h>
  12. #include "include.h"
  13.  
  14. #define $CREATE 00
  15. #define $GNAME 0111
  16.  
  17. #define $ORDY 01
  18. #define $FSTF 0103
  19. #define ERFDE 025
  20. #define ERDDE 023
  21. #define EREOF 030
  22.  
  23. #define SV_BUFF_SIZE 2048
  24.  
  25. #define PRSTART 020000
  26.  
  27. #define UST   0400
  28. #define USTBL 013
  29. #define USTST 016
  30. #define USTSZ 022
  31. #define USTSH 031
  32. #define RING_MASK 001777777777
  33. #define ST_REC_SIZE 0400
  34.  
  35. FILE    *fopen();
  36.  
  37. FILE    *mypr;
  38. FILE    *savedpr;
  39.  
  40. extern short fas_stchan;        /* .st channel for fasl io */
  41.  
  42. char    sv_buffer[SV_BUFF_SIZE];
  43. char    sv_in_buff[BUFSIZ];
  44. char    sv_o_buff[BUFSIZ];
  45.  
  46. savememory(filen)
  47. char    *filen;
  48. {
  49.     int    i;
  50.     char    prname[256];
  51.  
  52.     get_path(filen, prname);
  53.  
  54.     for (i = 0; prname[i] != '\0'; i++)
  55.         ;
  56.     i -= 3;
  57.     if (i < 1 || strcmp(prname + i, ".PR") != 0)
  58.         i += 3;        /* go back to last */
  59.     prname[i++] = '.';
  60.     prname[i++] = 'P';
  61.     prname[i++] = 'R';
  62.     prname[i] = '\0';
  63.  
  64.     mdump(prname);
  65.     ustcopy(prname);
  66.  
  67.     i -= 2;
  68.     prname[i++] = 'S';
  69.     prname[i++] = 'T';
  70.     prname[i] = '\0';
  71.     stcopy(prname);
  72. }
  73.  
  74. /* dump my process to filen */
  75.  
  76. mdump(filen)
  77. char    *filen;
  78. {
  79.     int    ac0, ac1, ac2, ier;
  80.  
  81.     unlink(filen);    /* first delete it */
  82.     ac0 = &ac0;    /* set ring 7 */
  83.     ac2 = filen;
  84.     if (ier = sys($MDUMP, &ac0, &ac1, &ac2))
  85.         sys_emes(ier);
  86. }
  87.  
  88. /*
  89.     ustcopy replaces ust of memory dumped file by the original
  90.     ust of .pr file, and also clears out the C library global
  91.     variable , i.e. _fdl and _chnl_blk area to prevent the C
  92.     envirionment initializing error.
  93. */
  94. ustcopy(filen)
  95. char    *filen;
  96. {
  97.     int    i, ier;
  98.     short    *ust;
  99.     int    impure_block;
  100.     int    shared_start;
  101.     int    shared_size;
  102.     int    shared_block_no;
  103.     int    _fdl_addr, _chnl_blk_addr;
  104.     int    stack_base;
  105.     int    stack_limit;
  106.     char    myname[256];
  107.  
  108.     get_prname(myname);
  109.     mypr = fopen(myname, "r");
  110.     if (mypr == NULL) sys_emes(lasterror());
  111.     setbuf(mypr, sv_in_buff);
  112.  
  113.     savedpr = fopen(filen, "r+");
  114.     if (savedpr == NULL) sys_emes(lasterror());
  115.     setbuf(savedpr, sv_o_buff);
  116.     
  117.     if (fread(sv_buffer, SV_BUFF_SIZE, 1, savedpr) != 1)
  118.         sys_emes(lasterror());
  119.  
  120.     /*
  121.     remember unshared and shared size... of memory dumped file.
  122.     */
  123.     ust = (short *)sv_buffer + UST;
  124.     impure_block = *(int *)(ust + USTBL);
  125.     shared_start = *(int *)(ust + USTST);
  126.     shared_size = *(int *)(ust + USTSZ);
  127.     shared_block_no = *(int *)(ust + USTSH);
  128.  
  129.     stack_base = *((int *)sv_buffer + 0270);
  130.     stack_limit = *((int *)sv_buffer + 0267);
  131.  
  132.     if (fseek(savedpr, 0, 0)) sys_emes(lasterror());
  133.  
  134.     if (fread(sv_buffer, SV_BUFF_SIZE, 1, mypr) != 1)
  135.         sys_emes(lasterror());
  136.  
  137.     *(int *)(ust + USTBL) = impure_block;
  138.     *(int *)(ust + USTST) = shared_start;
  139.     *(int *)(ust + USTSZ) = shared_size;
  140.     *(int *)(ust + USTSH) = shared_block_no;
  141.  
  142.     if (fwrite(sv_buffer, SV_BUFF_SIZE, 1, savedpr) != 1)
  143.         sys_emes(lasterror());
  144.  
  145.     for (i = 1; i < 8; i++) {
  146.         if (fread(sv_buffer, SV_BUFF_SIZE, 1, mypr) != 1)
  147.             sys_emes(lasterror());
  148.         if (fwrite(sv_buffer, SV_BUFF_SIZE, 1, savedpr) != 1)
  149.             sys_emes(lasterror());
  150.     }
  151.  
  152. /*    if (fseek(mypr, PRSTART * 2, 0))
  153.         sys_emes(lasterror());        */
  154.     if (fseek(savedpr, PRSTART * 2, 0))
  155.         sys_emes(lasterror());
  156.  
  157.     if (fread(sv_buffer, 050 * 2, 1, savedpr) != 1)
  158.         sys_emes(lasterror());
  159.     /*
  160.      * set up stack registers
  161.     */
  162.     *((int *)sv_buffer + 013) = stack_base;    /* stack base */
  163.     *((int *)sv_buffer + 011) = stack_base;    /* stack pointer */
  164.     *((int *)sv_buffer + 012) = stack_limit; /* stack limit */
  165.     *((int *)sv_buffer + 010) = 0;        /* frame pointer */
  166.  
  167.     if (fseek(savedpr, PRSTART * 2, 0))
  168.         sys_emes(lasterror());
  169.     if (fwrite(sv_buffer, 050 * 2, 1, savedpr) != 1)
  170.         sys_emes(lasterror());
  171.  
  172. /*
  173.     if (fseek(mypr, (PRSTART + 0400) * 2, 0))
  174.         sys_emes(lasterror());
  175.     if (fseek(savedpr, (PRSTART + 0400) * 2, 0))
  176.         sys_emes(lasterror());
  177.     if (fread(sv_buffer, 050 * 2, 1, mypr) != 1)
  178.         sys_emes(lasterror());
  179.     if (fwrite(sv_buffer, 050 * 2, 1, savedpr) != 1)
  180.         sys_emes(lasterror());
  181. */
  182.  
  183.     fclose(mypr);
  184.  
  185.     if (fas_stchan == -1) fasl_openst();
  186.     if (ier = fasl_st("_chnl_blk", &_chnl_blk_addr))
  187.         sys_emes(ier);
  188.     if (ier = fasl_st("_fdl", &_fdl_addr))
  189.         sys_emes(ier);
  190.  
  191.     _chnl_blk_addr = (_chnl_blk_addr & RING_MASK) + PRSTART;
  192.     _fdl_addr = (_fdl_addr & RING_MASK) + PRSTART;
  193.  
  194.     if (fseek(savedpr, _chnl_blk_addr * 2, 0))
  195.         sys_emes(lasterror());
  196.  
  197.     zero(sv_buffer, SV_BUFF_SIZE);
  198.     if (fwrite(sv_buffer, SV_BUFF_SIZE, 2, savedpr) != 2)
  199.         sys_emes(lasterror());
  200.     if (fwrite(sv_buffer, 0400, 1, savedpr) != 1)
  201.         sys_emes(lasterror());
  202.     if (fseek(savedpr, _fdl_addr * 2, 0)) sys_emes(lasterror());
  203.     if (fwrite(sv_buffer, 0200, 1, savedpr) != 1)
  204.         sys_emes(lasterror());
  205.     fclose(savedpr);
  206. }
  207.  
  208. /*
  209.     stcopy copies .st file.
  210. */
  211. stcopy(filen)
  212. char    *filen;
  213. {
  214.     int    ac0, ac1, ac2, ier;
  215.     char    mystname[256];
  216.     FILE    *myst;
  217.     FILE    *newst;
  218.     P_CREATE crpack;
  219.  
  220.     get_stname(mystname);
  221.  
  222.     unlink(filen);        /* if exist, delete it */
  223.  
  224.     crpack.cftyp_format = $ORDY;
  225.     crpack.cftyp_entry = $FSTF;
  226.     crpack.ccps = 0;
  227.     crpack.ctim = -1;
  228.     crpack.cacp = -1;
  229.     crpack.cdeh = 0;
  230.     crpack.cdel = 4;
  231.     crpack.cmil = 3;
  232.     crpack.cmrs = 0;
  233.  
  234.     ac0 = filen;
  235.     ac2 = &crpack;
  236.     if (ier = sys($CREATE, &ac0, &ac1, &ac2))
  237.         sys_emes(ier);
  238.  
  239.     if ((myst = fopen(mystname, "r")) == NULL)
  240.         sys_emes(lasterror());
  241.     setbuf(myst, sv_in_buff);
  242.     if ((newst = fopen(filen, "w")) == NULL)
  243.         sys_emes(lasterror());
  244.     setbuf(newst, sv_o_buff);
  245.     
  246.     for (;;) {
  247.         if (fread(sv_buffer, ST_REC_SIZE, 1, myst) != 1)
  248.             if ((ier = lasterror()) == EREOF)
  249.                 break;
  250.             else
  251.                 sys_emes(ier);
  252.         if (fwrite(sv_buffer, ST_REC_SIZE, 1, newst) != 1)
  253.             sys_emes(lasterror());
  254.     }
  255.     fclose(myst);
  256.     fclose(newst);
  257. }
  258.  
  259. /*
  260.     get_path convert a filename to the full path name.
  261. */
  262. get_path(filen, fpath)
  263. char    *filen;
  264. char    *fpath;
  265. {
  266.     char    dir[256];
  267.     int    i, j, ac0, ac1, ac2, ier;
  268.  
  269.     for (i = 0; filen[i] != '\0'; i++)
  270.         ;
  271.     for (;  i >=0 &&
  272.         filen[i] != ':' &&
  273.         filen[i] != '=' &&
  274.         filen[i] != '@' &&
  275.         filen[i] != '^'        ; i--)
  276.         ;
  277.     if (i < 0) {
  278.         dir[0] = '=';
  279.         dir[1] = '\0';
  280.     } else {
  281.         for (j = 0; j <= i; j++)
  282.             dir[j] = filen[j];
  283.         dir[j] = '\0';
  284.         if (dir[j-1] == ':' && j != 1 )
  285.             dir[j-1] = '\0';
  286.  
  287.     }
  288.     ac0 = dir;
  289.     ac1 = fpath;
  290.     ac2 = 256;
  291.  
  292.     if (ier = sys($GNAME, &ac0, &ac1, &ac2))
  293.         if (ier == ERFDE)       /* file does not exist */
  294.             sys_emes(ERDDE);   /* dir does not exist */
  295.         else
  296.             sys_emes(ier);
  297.     if (ac2 != 1)
  298.         fpath[ac2++] = ':';
  299.     for (j = ac2, i++; (fpath[j] = toupper(filen[i])) != '\0'
  300.         ; j++, i++)
  301.         ;
  302. }
  303.  
  304. Lsave()
  305. {
  306.     object    x;
  307.     int    len, i, ier;
  308.     char    *cp;
  309.     char    filen[256];
  310.  
  311.     short *sp;
  312.  
  313.     check_arg(1);
  314.     check_type_or_pathname_string_symbol_stream(&vs_base[0]);
  315.     x = coerce_to_namestring(vs_base[0]);
  316.     vs_push(x);
  317.  
  318.     cp = x->st.st_self;
  319.     len = x->st.st_dim;
  320.  
  321.     for (i=0; i < len; i++) filen[i] = cp[i];
  322.     filen[i] = '\0';
  323.  
  324.     savememory(filen);
  325.     vs_top = vs_base;
  326.     vs_push(Ct);
  327. }
  328.  
  329. init_save()
  330. {
  331.     make_function("SAVE", Lsave);
  332. }
  333.